#!/usr/bin/perl -w
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this program.  If not, see
# <http://www.gnu.org/licenses/>.


use strict;
use Getopt::Long;
use Pod::Usage;

sub evalcode($$);
sub formatcode($$$);
sub formatblock($$$);


# Read command line arguments
my $input;
my $output;
my $codewidth = 80;
my @modules   = ();
my @includes  = ();
my @constants = ();
{
    my $help = 0;
    my $man  = 0;

    Getopt::Long::Configure ("bundling");
    
    GetOptions(
        'help|?'      => \$help,
        'man'         => \$man,
        'i|input:s'   => \$input,
        'o|output:s'  => \$output,
        'w|width:i'   => \$codewidth,
        'm|module:s'  => \@modules,
        'I|include:s' => \@includes,
        'D|define:s'  => \@constants)
        or pod2usage(-verbose => 0);
    
    pod2usage({-exitval => 0, -verbose => 0})  if $help;
    pod2usage({-exitval => 0, -verbose => 2})  if $man;
}

# Add include paths to Perl's own include path list
push (@INC, @includes);

# Use all modules specified on the command line.
for (@modules)
{
    eval "use $_"; die $@ if $@;
}

# Read input
my $contents = "";
if (defined $input)
{
    open(my $fh, "<", $input) or die "cannot open $input: $!";
    $contents .= $_ for (<$fh>);
    close($fh);
}
else
{
    $contents .= $_ for (<STDIN>);
}

# Escape input to avoid parsing errors when the input contains ' and \
$contents =~ s/\\/\\\\/g;
$contents =~ s/'/\\\'/g;

# Remove artificial newlines/spacing created by tags that print nothing
$contents =~ s/[ \t]*(\/\*\- *.*?\*\/)[ \t]*\r?\n/$1/sg;

# Change input into a Perl script that prints the desired output
$contents = "print '$contents";
$contents =~ s/\/\*([\-\+\$]) *(.*?)\*\//evalcode($1, $2)/sge;
$contents =~ s/(.*?)\/\*(\=) *(.*?)\*\//formatcode($1, $2, $3)/ge;
$contents .= "';\n";

# Add constants specified on the command line
my $constdecl = "";
for (@constants)
{
    my ($name, $value) = split(/=/);
    die ("Error: invalid constant specification")
        unless defined $name && defined $value;
    $constdecl .= "use constant $name => \'$value\';";
}

# Evaluate the script generated
my $results = "";

if (defined $output)
{
    close STDOUT;
    open(STDOUT, ">", \$results) or die "cannot redirect STDOUT: $!";
}

eval "{$constdecl $contents}"; die $@ if $@;

if (defined $output)
{
    open(my $fh, ">", $output) or die "cannot open $output: $!";
    print $fh $results;
    close($fh);
}

# Evaluate a tag that is being parsed and return the perl code it
# should generate.
sub evalcode($$)
{
    my ($symbol, $code) = @_;
    my $output = "";

    # Unescape code that was previously escaped along with normal text
    $code =~ s/\\\\/\\/g;
    $code =~ s/\\\'/'/g;

    # /*$ variable */: Print $variable
    $code = "print \$$code if defined \$$code;" if ($symbol eq '$');

    # /*+ code */: Execute code and print its return value
    $code = "print $code;" if ($symbol eq '+');

    return "';\n$code\nprint '";
}


# Evaluate a formatted print tag that is being parsed and return the
# perl code to format it with the indentation detected.
sub formatcode($$$)
{
    my ($beg, $symbol, $code) = @_;

    # Unescape code that was previously escaped along with normal text
    $code =~ s/\\\\/\\/g;
    $code =~ s/\\\'/'/g;

    $code = "
{
    my \$block = $code;
    \$block = \'\' unless defined \$block;
    print formatblock(\$block, \'$beg\', \$codewidth);
}
";
    return "';\n$code\nprint '";
}


# Format a block of code to fit a specified width. This is particarly
# useful for formatting inline documentation in the generated code.
sub formatblock($$$)
{
    my ($block, $prefix, $width) = @_;
    my $endl = "\n";

    # Remove all newlines within paragraphs and guess line delimiter
    $endl  = $2 if $block =~ s/([^\r\n\s])(\r?\n)([\w])/$1 $3/g && defined $2;
    $block =~ s/^\s//s;
    $block =~ s/\s$//s;

    # Cut the paragraphs to the width requested and insert the
    # indentation.
    my $output = "";
    for my $line (split /$endl/, $block)
    {
        my $spacing = $line =~ s/^(\W*)// && defined $1 ? $1 : "";
        $output .= $prefix.$spacing;

        my $col = length($spacing) + length($prefix);
        $spacing =~ s/\S/ /;
        
        for my $word (split /(\s+)/, $line)
        {
            if ($col + length($word) > $width)
            {
                $output .= $endl.$prefix.$spacing;
                $col     = length($spacing) + length($prefix);
                $word = "" if ($word =~ /^\s*$/);
            }
            $output .= $word;
            $col    += length($word);
        }
        $output .= $endl;
    }

    $output =~ s/\s$//s;

    return $output;
}


__END__

=head1 NAME

codegen - Code generator that uses perl-infused templates

=head1 SYNOPSIS

codegen [options] [-m module]... -i template -o sourcefile

 Options:
  --help,    -?  brief help message
  --man          full documentation
  --module,  -m  use the module specified.
  --width,   -w  specify the width of formatted blocks (default: 80)
  --input,   -i  input filename
  --output,  -o  output filename
  --include, -I  add an include directory
  --define,  -D  define a constant

=head1 OPTIONS

=over 8

=item B<--help, -?>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--module, -m>

Use the module specified. Contents of the module will become available
from inside the template.

=item B<--width, -w>

Specify the maximum width of formatted text blocks (blocks inserted using
/*= ... */ tags).

=item B<--input, -i>

Specify the file that contains the template.

=item B<--output, -o>

Specify the processed output file.

=item B<--include, -I>

Add a directory to Perl's include directory array (@INC). These
directories are used when searching for modules, such as the ones
specified with the --module option.

=item B<--define, -D>

Define a constant in the scope of the template using the NAME=value
form.

=back

=head1 DESCRIPTION

B<codegen> is a template processor that replaces some special
tags with Perl code. A template is a plain text file
that may contain one or many occurences of the following tags:
 - Perl code: /*- */
   Evaluates the Perl code enclosed and prints its output, if any,
   at the tag's position.
 - Perl expression print: /*+ */
   Evaluate the Perl expression enclosed and prints its return value.
 - Perl variable print: /*$ */
   Prints the variable whose name is enclosed at the tag's position.
 - Formatted block print: /*= */
   Formats the enclosed block by cutting line width to 80 columns
   and applying the same indentation as the tag itself.

=cut
